Modelo Predictivo de la Deserción en la Educación Media Superior
Valeria Serrano Cote & Juan Carlos Soto Hernández
2021-12-06
Prefacio
“La comprensión se utiliza con más frecuencia para tratar de alterar el resultado que para repetirlo o perpetuarlo”
— Jared Diamond
Este documento tiene la finalidad utilizar aprendizaje de máquina para identificar y predecir la frecuencia de factores que condicionan la deserción en la educación media. Toma como eje el trabajo publicado en 2012, denominado “Reporte de la Encuesta Nacional de Deserción en la Educación Media Superior” (ENDEMS) el cual es la única encuesta en este país para intertar entender cuál es la razón de la deserción escolar.
Consiste en 13,014 entrevistas realizadas a 6,472 mujeres y 6,542 hombres, de estas entrevistas 4,770 jóvenes nunca se matricularon en el nivel medio superior y 2,549 desertaron; el resto, 5,686 continúan estudiando o concluyeron este nivel.
Los siguientes son datos generales de la encuesta, sin embargo para el trabajo final se modificaron las variables por lo que el número de encuestas que se utilizaron resultó menor.
Datos Generales de la Encuesta Nacional de Deserción en la Educación Media Superior
Cobertura geográfica.
La cobertura geográfica es representativa a nivel nacional de viviendas particulares en localidades con más de 500 habitantes.
Periodo de referencia.
Del 25 de junio al 30 de julio de 2011.
Población de Interés.
Existen una población de interés y 3 subpoblaciones.
1. Los desertores: aquellos jóvenes que iniciaron la Educación Media Superior y al momento de la entrevista no la habían concluido ni se encontraban realizando estudios para concluir este nivel educativo.
2. Los no desertores: aquellos estudiantes que iniciaron la Educación Media Superior y al momento de la entrevista: a) ya la habían terminaron, o b) no la habían terminado pero seguían estudiando para completarla.
3. Los no matriculados: aquellos jóvenes que al momento de la entrevista no estaban inscritos en la Educación Media Superior, ya sea porque seguían estudiando y todavía no terminaban la secundaria o porque no estaban estudiando y abandonaron sus estudios en algún momento anterior a la media superior.
El tamaño de muestra se fijó en 2,000 desertores, para lo cual se estimó necesario visitar 44,000 viviendas. De esta forma, se aprovechó también el número de visitas para recabar informacíon de jóvenes que nunca se inscribieron a la Educación Media Superior, ya sea porque seguían estudiando la secundaria, porque desertaron del sistema educativo mientras estudiaban la Educación Básica o porque concluyeron ese nivel y no transitaron al siguiente.
El esquema de muestreo fue probabilista, estratificado, por conglomerados y polietáptico. La población objetivo de la ENDEMS estuvo compuesta por jóvenes, hombres y mujeres, de entre 14 y 25 años de edad que residían permanentemente en viviendas particulares ubicadas en localidades con más de 500 habitantes dentro del territorio nacional.
La ENDEMS es la primera encuesta que se levanta en México específicamente sobre deserción en la Educación Media Superior y que es representativa a nivel nacional.
Introducción
Para entender el objeto de este estudio es necesario que demos una descripción muy precisa de lo que es la deserción escolar.
- Deserción escolar
- “el total de alumnos que abandonan las actividades escolares antes de concluir un grado o nivel educativo”
Es decir, para cuantificar la deserción, se deberá contabilizar a los individuos que ya una vez inscritos en algún grado escolar, abandonan los estudios parcial o completamente. 1
De esta manera la Deserción escolar total se puede calcular como la suma de la deserción intercurricular y la deserción intracurricular.
La deserción intracurricular se refiere al abandono escolar que se presenta en el interior de un ciclo escolar; es decir, mientras el programa de estudios se está desarrollando. En esta vertiente, el alumno no concluye el ciclo escolar al que se inscribió.
En cambio, la deserción intercurricular se presenta en el intermedio de dos ciclos escolares; es decir, ocurre cuando un alumno concluye un ciclo escolar y no se inscribe al siguiente, independientemente de si aprobó o no.
De manera general para el caso Mexicano se puede observar el siguiente escenario:
De 100 alumnos inscritos en primaria, 60 concluyeron la secundaria, y 36 terminaron el bachillerato.
En términos prácticos un desertor es:
“Aquella persona que inició el grado o el nivel educativo correspondiente, no lo concluyó y no se encuentra realizando estudios para alcanzar dicha conclusión”
Datos ocupados de la ENDEMS
Este apartado carga los datos y examina las principales variables, además recodifica tanto las clases de las diferentes columnas qeu componen el set de datos y otorga las diferentes categorías a las variables
Lo primero que se tuvo que hacer fue modificar la encuesta ya que su unidad básica era el hogar, por ello se tuvieron que trabajar los datos para colocarlos por población objetivo, es decir aquelos jóvenes entre \(18\) y \(25\) años que habían o no deseratado de la educación media superior.
Este punto es relevante porque lo que se quiere es predecir qué jóvenes dejarán de estudiar antes de concluir el bachillerato. Los jóvenes entre 14 y 17 años que están estudiando el bachillerato al momento de la encuesta, no puden catalogarse como no desertores, ya que si bien es cierto que al momento de la encuesta están asistiendo a la preparatoria, eso no quiere decir que al siguiente año vayan a continuar estudiando.
Es por ello que solo se tomaron en cuentas a aquellos individuos que tuvieran entre 18 y 25 años, así como aquellos que desertaron antes de los 17 años.
Al hacer esto nos encotramos con una base de \(8,136\) adolescentes que fueron entrevistados (diferentes a las 13,014 viviendas en las que se había aplicado la encuesta)
#encuesta <- read_dta("./Data/basefinal.dta")
#source("recodifica.R")
#saveRDS(encuesta, "./Data/encuesta.rds")
encuesta <- readRDS("./Data/encuesta.rds")
encuesta %>% nrow## [1] 8136Una vez cargada la encuesta, encontramos que no estaba codificada por ello, tomamos todos los datos y construimos los factores, haciendo más manejable la encuesta, cabe señalar que esta parte del trabajo tomó mucho tiempo ya que se codificaron las variables.
La siguiente es una base filtrada con todos los jóvenes que se entrevistaron y tienen entre 18 y 25 años, edad en la que ya deberían haber terminado la educación media superior, así como aquellos que desertaron con menos de 17 años.
head(encuesta,4) ## # A tibble: 4 × 64
## edo edad sexo prom_sec secpublica camboesc freqasis prom_ems reprueba
## <fct> <int> <fct> <dbl> <fct> <dbl> <fct> <dbl> <fct>
## 1 Ags 17 mujer 9.6 no 0 siempre asi… 9.2 no
## 2 Ags 21 hombre 7.6 si 0 faltaba con… 8.5 si
## 3 Ags 16 hombre 8.3 si 0 asistia reg… 8.5 si
## 4 Ags 19 hombre 8.1 si 0 asistia reg… 8.5 si
## # … with 55 more variables: nivelprom <fct>, becado <fct>, p23_1 <fct>,
## # p23_2 <fct>, p24_1 <fct>, p24_2 <fct>, p24_3 <fct>, p24_4 <fct>,
## # p24_5 <fct>, p24_6 <fct>, p24_7 <fct>, p24_8 <fct>, p24_9 <fct>,
## # p24_10 <fct>, p24_11 <fct>, p24_12 <fct>, p24_13 <fct>, p24_14 <fct>,
## # p24_15 <fct>, p24_16 <fct>, p24_17 <fct>, p24_18 <fct>, p24_19 <fct>,
## # p24_20 <fct>, p24_21 <fct>, p24_22 <fct>, p24_23 <fct>, trab_est <fct>,
## # ncuartos <dbl>, p40_1 <fct>, p40_2 <fct>, p40_3 <fct>, p40_4 <fct>, …Renombrar las variables.
Se cambia el nombre de las variables para darles más significado.
encuesta <- rename(encuesta,
edo = edo,
edad = edad,
sexo = sexo,
prom_sec = prom_sec,
sec_publica = secpublica,
cambio_esc = camboesc,
asistencia = freqasis,
p15 = prom_ems,
reprueba = reprueba,
prom_bach = nivelprom,
becado = becado,
desertor_amigos = p23_1,
desertor_hermanos = p23_2,
faltaba_dinero = p24_1,
prob_turno = p24_2,
baja_reprueba = p24_3,
disg_estudiar = p24_4,
indisciplina = p24_5,
mejor_trabaja = p24_6,
no_entiende = p24_7,
esc_lejos = p24_8,
cambio_casa = p24_9,
bulling = p24_10,
disciplina_estricta = p24_11,
discriminado = p24_12,
prob_familia = p24_13,
te_casaste = p24_14,
estudiaran_hermanos = p24_15,
inseguridad = p24_16,
fallecio_familiar = p24_17,
embarazo = p24_18,
malas_instalaciones = p24_19,
querias_cambiar_escuela = p24_20,
estudiar_no_sirve = p24_21,
baja_autoestima = p24_22,
motivo_otro = p24_23,
trab_est = trab_est,
ncuartos = ncuartos,
tele = p40_1,
dvd = p40_2,
refri = p40_3,
estufa = p40_4,
piso_tierra = p40_5,
lavadora = p40_6,
auto = p40_7,
microondas = p40_8,
computadora = p40_9,
agua = p40_10,
telefono = p40_11,
internet = p40_12,
excusado = p40_13,
letrina = p40_14,
cable = p40_15,
id = id,
desertor = desertor,
tipo_escuela = tipoescuela,
vive_con = pervivia,
confia_esc = p13_esc,
confia_familia = p13_fami,
confia_amigos = p13_amg,
tabaco = tabaco,
alcohol = alcohol,
marihuana = marihuana,
otras_drogas = otrasdrog) Después de una segunda revisión se decidieron quitar las siguientes variables:
encuesta <- encuesta %>%
select(-p15,-baja_reprueba, -indisciplina, -id, -motivo_otro)Estas variables estaban relacionadas con la variable deserción, por ejemplo la pregunta p15, trataba sobre con cuál promedio de bachillerato te habías dado de baja, así mismo id era solo un indicador que diferiaba a un alumno de otro.
Estadísticos descriptivos del Abandono Escolar
Empezaremos este ejercicio dividiendo nuestra encuesta, en dos set de datos uno para el entrenamiento y otro para la prueba, por ese motivo decidimos separa la base usando un muestreo estratificado debido a que las muestra no es balanceada.
De una muestra total de \(8,136\) encuestados, decidimos guardar \(20\%\) como datos de prueba, siendo \(1,628\) y usar el restante \(80\%\) (\(6,508\)) como datos de entrenamiento, a su vez, separar el 20% de los datos de entrenamiento para usarlos como datos de validación \(1,302\).
| Division | Total | Porcentaje |
|---|---|---|
| Prueba | 1,628 | 20% |
| Entrenamiento | 6,508 | 80% |
| Total | 8,136 | 100% |
Posteriormente la muestra de entrenamiento se subdivide, para crear espacio para la muestra de validación.
| Division | Total | Porcentaje |
|---|---|---|
| Entrenamiento | 5,206 | 80% |
| Validación | 1,302 | 20% |
| Total | 6,508 | 100% |
set.seed(2021)
encuesta_part_inicial <- initial_split(encuesta, strata = desertor, prop = 0.80)
encuesta_total <- training(encuesta_part_inicial)
encuesta_part_val <- validation_split(encuesta_total, prop = 0.80)
encuesta_part_val$splits## [[1]]
## <Training/Validation/Total>
## <5206/1302/6508>Limpieza, exploración y análisis conceptual
Primero vamos a establecer que la variable desertor es la que estamos buscando, esta toma dos valores, 1 si el estudiante desertó y 0 si no lo hizo.
Podemos observar que se cuenta con \(42%\) de desertores y \(58%\) no desertores en la encuesta.
set.seed(2021)
entrena <- training(encuesta_part_val$splits[[1]])
nrow(entrena)## [1] 5206entrena%>% count(desertor) %>%
mutate(pcn = round(n / sum(n),2))## # A tibble: 2 × 3
## desertor n pcn
## <fct> <int> <dbl>
## 1 desertor 2167 0.42
## 2 no_desertor 3039 0.58tabla_univariada <- function(datos, variable, target){
datos %>% count({{ variable }}, {{ target }}) %>% group_by({{ variable }}) %>%
mutate(pcn = round(n / sum(n),2)) }Resumen general
Variables claramente importantes (hipótesis):
sexo prom_sec cambio_esc asistencia
reprueba prom_bach becado desertor_amigos
desertor_hermanos faltaba_dinero prob_turno disg_estudiar
mejor_trabaja no_entiende cambio_casa bulling
disciplina_estricta discriminado prob_familia te_casaste
estudiaran_hermanos embarazo estudiar_no_sirve baja_autoestima
trab_est ncuartos dvd piso_tierra
auto microondas computadora agua
telefono internet excusado letrina
cable tipo_escuela vive_con confia_esc
confia_familia confia_amigos alcohol
Variables que se eliminarán del modelo:
edo
sec_publica
querias_cambiar_escuela tele
refri
estufa
lavadora
confia_esc
confia_familia
confia_amigos
tabaco
marihuana
otras_drogas
¿Influye la entidad federativa en al que vive?
Podemos observar que etadoe como Ags, BC e Hgo, Tamps, Gro, Q. Roo, Yuc y Zac tienen porcentaje de deserción mayor al 53%. Siendo Ags la entidad com mayor deserción del país.
Eliminamos entidad deferativa porque la encuesta solo es representativa a nivel país.
tabla_univariada(entrena, edo, desertor) %>%
ggplot(aes(edo, pcn, fill = desertor)) +
geom_col(position = "stack") + ggtitle("¿Deserciones por entidad?") +
theme(axis.text.x = element_text(angle = 90))
tabla_univariada(entrena, edo, desertor) %>% filter(desertor == "desertor" & pcn >= .53) %>% arrange(desc(pcn))## # A tibble: 8 × 4
## # Groups: edo [8]
## edo desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 Ags desertor 62 0.68
## 2 BC desertor 56 0.55
## 3 Hgo desertor 53 0.55
## 4 Tamps desertor 56 0.54
## 5 Gro desertor 97 0.53
## 6 Q. Roo desertor 61 0.53
## 7 Yuc desertor 163 0.53
## 8 Zac desertor 65 0.53¿El género influye?
En la siguiente tabla puede ver que parecen ser números muy similares, es decir, se observa que mientras el \(43\%\) de los hombres desertan, el \(41\%\) de las mujeres lo hacen.
Incluso pensaría que el porcentaje de mujeres que sería superior pero los datos indican lo cotrario, la tasa de deserción de mujeres es ligeramente menor que la de los hombres.
entrena %>% select(sexo, desertor) %>%
group_by(sexo, desertor) %>%
tally() %>% mutate(pcn = round(n/sum(n),2)) %>%
ggplot(aes(sexo, pcn, fill= desertor)) + geom_col(position = "dodge") +
ggtitle("Desertores por sexo")
Promedio Secundaria
Al parecer las personas con un promedio superior a \(8\) en la secundaria tienen \(50\%\) de posibilidades de no desertar en el bachillerato.
tabla_univariada(entrena, prom_sec, desertor) %>%
ggplot(aes(prom_sec, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("Promedio Secundaria")
entrena %>% select(sexo, desertor, prom_sec ) %>% group_by(sexo, desertor) %>%
ggplot(aes(prom_sec, sexo, fill = desertor)) +
geom_boxplot() + ggtitle("Promedio Secundaria")
Pública o Privada
Se observa que si la educación es privada la probabilidad de deserción es \(36\%\), mientras que si es pública es \(42\%\).
tabla_univariada(entrena, sec_publica, desertor) %>%
ggplot(aes(sec_publica, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("Tipo de Secundaria a la que asistió")
Cuántas veces cambiaste de preparatoria
tabla_univariada(entrena, cambio_esc, desertor) %>%
ggplot(aes(cambio_esc, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("Número de veces que cambiaste de prepa") + xlab("")
¿Qué tanto asistias a tus clases?
Esta variabble es relevante porque muestra un gran cambio en la posibilida de desertar disminuye a medida que aumenta la asitencia a la preparatoria.
tabla_univariada(entrena, asistencia, desertor) %>%
ggplot(aes(asistencia, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿Qué tanto faltabas a clase?") +
scale_x_discrete(guide = ggplot2::guide_axis(n.dodge = 2),
labels = function(x) stringr::str_wrap(x, width = 20)) + xlab("")
¿Reprobaste alguna materia en la prepa?
Si reprobaste aunque sea una materia tienes el \(50\%\) de posibilidades de desertar.
tabla_univariada(entrena, reprueba, desertor) %>%
ggplot(aes(reprueba, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿Reprobaste alguna materia?") +
xlab("")
¿Cómo consideras que era tu promedio cuando estabas en bachillerato?
Este es un indicador importante, qeu indica que si el joiven considera que tiene un promedio muy bajo existe el \(80\%\) de probailidad de que se de de baja.
tabla_univariada(entrena, prom_bach, desertor) %>%
ggplot(aes(prom_bach, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿Como consideras que era tu promedio?") +
scale_x_discrete(guide = ggplot2::guide_axis(n.dodge = 2),
labels = function(x) stringr::str_wrap(x, width = 10)) + xlab("")
¿Influye la beca?
Si estabas becado era muy probable que \(73\%\) que no desertaras, comparado con el \(55\%\) si no tenías beca.
tabla_univariada(entrena, becado, desertor) %>%
ggplot(aes(becado, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿Estabas becado?") +
scale_x_discrete(guide = ggplot2::guide_axis(n.dodge = 2),
labels = function(x) stringr::str_wrap(x, width = 10)) + xlab("")
¿Tuviste amigos o hermanos que desertaron?
La variable más importante es si tuviste hermanos que desertaron ya que tu probabilidad de desertar es del \(56\%\) en cambio si tienes hermanos que desertaron tu probabilida de desertar es del \(44\%\).
tabla_univariada(entrena, desertor_amigos, desertor)## # A tibble: 4 × 4
## # Groups: desertor_amigos [2]
## desertor_amigos desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 1124 0.44
## 2 si no_desertor 1420 0.56
## 3 no desertor 1043 0.39
## 4 no no_desertor 1619 0.61tabla_univariada(entrena, desertor_hermanos, desertor)## # A tibble: 4 × 4
## # Groups: desertor_hermanos [2]
## desertor_hermanos desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 392 0.56
## 2 si no_desertor 306 0.44
## 3 no desertor 1775 0.39
## 4 no no_desertor 2733 0.61Ahora tenemos una serie de variables en las que preguntan sobre la situación en su casa
A continuación veremos las siguientes variables: faltaba_dinero prob_turno baja_reprueba
disg_estudiar indisciplina mejor_trabaja
no_entiende esc_lejos cambio_casa
bulling disciplina_estricta discriminado
prob_familia te_casate estudiaran_hermanos
inseguridad fallecio_familiar embarazo
malas_instalaciones querias_cambiar_escuela estudiar_no_sirve
baja_autoestima
De estas las que están más fuertemente relacionadas con la deserción son: * le disgusta estudiar(\(68\%\)) * mejor prefiere trabajar(\(72\%\)) * te casaste (\(77\%\)) * embarazo (\(76\%\)) * estudiar no sirve (\(72\%\)) * baja autoestima (\(64\%\)) * discriminado (\(58\%\)) * problemas en la familia (\(58\%\)) * estudiaran hermanos (\(59\%\))
tabla_univariada(entrena, faltaba_dinero, desertor)## # A tibble: 4 × 4
## # Groups: faltaba_dinero [2]
## faltaba_dinero desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 1332 0.5
## 2 si no_desertor 1312 0.5
## 3 no desertor 835 0.33
## 4 no no_desertor 1727 0.67tabla_univariada(entrena, prob_turno, desertor)## # A tibble: 4 × 4
## # Groups: prob_turno [2]
## prob_turno desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 344 0.47
## 2 si no_desertor 386 0.53
## 3 no desertor 1823 0.41
## 4 no no_desertor 2653 0.59tabla_univariada(entrena, mejor_trabaja, desertor)## # A tibble: 4 × 4
## # Groups: mejor_trabaja [2]
## mejor_trabaja desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 586 0.72
## 2 si menciono no_desertor 225 0.28
## 3 no menciono desertor 1581 0.36
## 4 no menciono no_desertor 2814 0.64tabla_univariada(entrena, no_entiende, desertor)## # A tibble: 4 × 4
## # Groups: no_entiende [2]
## no_entiende desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 664 0.55
## 2 si menciono no_desertor 536 0.45
## 3 no menciono desertor 1503 0.38
## 4 no menciono no_desertor 2503 0.62tabla_univariada(entrena, esc_lejos, desertor)## # A tibble: 4 × 4
## # Groups: esc_lejos [2]
## esc_lejos desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 367 0.43
## 2 si menciono no_desertor 479 0.57
## 3 no menciono desertor 1800 0.41
## 4 no menciono no_desertor 2560 0.59tabla_univariada(entrena, cambio_casa, desertor)## # A tibble: 4 × 4
## # Groups: cambio_casa [2]
## cambio_casa desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 164 0.48
## 2 si menciono no_desertor 180 0.52
## 3 no menciono desertor 2003 0.41
## 4 no menciono no_desertor 2859 0.59tabla_univariada(entrena, bulling, desertor)## # A tibble: 4 × 4
## # Groups: bulling [2]
## bulling desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 298 0.48
## 2 si menciono no_desertor 324 0.52
## 3 no menciono desertor 1869 0.41
## 4 no menciono no_desertor 2715 0.59tabla_univariada(entrena, disciplina_estricta, desertor)## # A tibble: 4 × 4
## # Groups: disciplina_estricta [2]
## disciplina_estricta desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 453 0.43
## 2 si menciono no_desertor 606 0.57
## 3 no menciono desertor 1714 0.41
## 4 no menciono no_desertor 2433 0.59tabla_univariada(entrena, discriminado, desertor)## # A tibble: 4 × 4
## # Groups: discriminado [2]
## discriminado desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 187 0.58
## 2 si menciono no_desertor 133 0.42
## 3 no menciono desertor 1980 0.41
## 4 no menciono no_desertor 2906 0.59tabla_univariada(entrena, prob_familia, desertor)## # A tibble: 4 × 4
## # Groups: prob_familia [2]
## prob_familia desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 300 0.58
## 2 si menciono no_desertor 217 0.42
## 3 no menciono desertor 1867 0.4
## 4 no menciono no_desertor 2822 0.6tabla_univariada(entrena, estudiaran_hermanos, desertor)## # A tibble: 4 × 4
## # Groups: estudiaran_hermanos [2]
## estudiaran_hermanos desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 118 0.59
## 2 si menciono no_desertor 82 0.41
## 3 no menciono desertor 2049 0.41
## 4 no menciono no_desertor 2957 0.59tabla_univariada(entrena, inseguridad, desertor)## # A tibble: 4 × 4
## # Groups: inseguridad [2]
## inseguridad desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 177 0.39
## 2 si menciono no_desertor 274 0.61
## 3 no menciono desertor 1990 0.42
## 4 no menciono no_desertor 2765 0.58tabla_univariada(entrena, fallecio_familiar, desertor)## # A tibble: 4 × 4
## # Groups: fallecio_familiar [2]
## fallecio_familiar desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 217 0.37
## 2 si menciono no_desertor 362 0.63
## 3 no menciono desertor 1950 0.42
## 4 no menciono no_desertor 2677 0.58tabla_univariada(entrena, malas_instalaciones, desertor)## # A tibble: 4 × 4
## # Groups: malas_instalaciones [2]
## malas_instalaciones desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 195 0.42
## 2 si menciono no_desertor 266 0.58
## 3 no menciono desertor 1972 0.42
## 4 no menciono no_desertor 2773 0.58tabla_univariada(entrena, querias_cambiar_escuela, desertor)## # A tibble: 4 × 4
## # Groups: querias_cambiar_escuela [2]
## querias_cambiar_escuela desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 161 0.62
## 2 si menciono no_desertor 99 0.38
## 3 no menciono desertor 2006 0.41
## 4 no menciono no_desertor 2940 0.59tabla_univariada(entrena,estudiar_no_sirve, desertor)## # A tibble: 4 × 4
## # Groups: estudiar_no_sirve [2]
## estudiar_no_sirve desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 163 0.72
## 2 si menciono no_desertor 63 0.28
## 3 no menciono desertor 2004 0.4
## 4 no menciono no_desertor 2976 0.6tabla_univariada(entrena, baja_autoestima, desertor)## # A tibble: 4 × 4
## # Groups: baja_autoestima [2]
## baja_autoestima desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si menciono desertor 197 0.64
## 2 si menciono no_desertor 109 0.36
## 3 no menciono desertor 1970 0.4
## 4 no menciono no_desertor 2930 0.6tabla_univariada(entrena, te_casaste, desertor) %>% ggplot(aes(te_casaste, pcn, fill = desertor)) + geom_col(position ="dodge") + ggtitle("Te casate")
tabla_univariada(entrena, embarazo, desertor) %>% ggplot(aes(embarazo, pcn, fill = desertor)) + geom_col(position ="dodge") + ggtitle("Te embarazaste")
tabla_univariada(entrena, disg_estudiar, desertor) %>% ggplot(aes(disg_estudiar, pcn, fill = desertor)) + geom_col(position ="dodge") + ggtitle("Te disgusta estudiar")
¿Trabajaba mientras estudiaba?
Mo parece ser una variable relevante
tabla_univariada(entrena, trab_est , desertor) %>%
ggplot(aes(trab_est , pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿Trabaja mientras estudia?") +
xlab("")
¿Cuántos cuartos tiene tu casa?
Al aumentar el número de cuartos aumenta la probabilidad de terminar el bachillerato.
tabla_univariada(entrena, ncuartos, desertor) %>% ggplot(aes(factor(ncuartos), pcn, fill = desertor)) + geom_col(position = "dodge") + ggtitle("¿Cuántos cuartos tiene su casa?") +
xlab("")
tabla_univariada(entrena, ncuartos, desertor) %>% ggplot(aes(ncuartos, fill = desertor)) + geom_boxplot() + ggtitle("¿Cuántos cuartos tiene su casa?") +
xlab("")
¿En su casa cuenta con lo siguiente?
tabla_univariada(entrena, tele, desertor)## # A tibble: 4 × 4
## # Groups: tele [2]
## tele desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 2089 0.41
## 2 si no_desertor 2992 0.59
## 3 no desertor 78 0.62
## 4 no no_desertor 47 0.38tabla_univariada(entrena, dvd, desertor)## # A tibble: 4 × 4
## # Groups: dvd [2]
## dvd desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 1555 0.39
## 2 si no_desertor 2463 0.61
## 3 no desertor 612 0.52
## 4 no no_desertor 576 0.48tabla_univariada(entrena, refri, desertor)## # A tibble: 4 × 4
## # Groups: refri [2]
## refri desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 1958 0.4
## 2 si no_desertor 2877 0.6
## 3 no desertor 209 0.56
## 4 no no_desertor 162 0.44tabla_univariada(entrena, estufa, desertor)## # A tibble: 4 × 4
## # Groups: estufa [2]
## estufa desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 2021 0.41
## 2 si no_desertor 2939 0.59
## 3 no desertor 146 0.59
## 4 no no_desertor 100 0.41tabla_univariada(entrena, piso_tierra, desertor)## # A tibble: 4 × 4
## # Groups: piso_tierra [2]
## piso_tierra desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 319 0.46
## 2 si no_desertor 382 0.54
## 3 no desertor 1848 0.41
## 4 no no_desertor 2657 0.59tabla_univariada(entrena, lavadora, desertor)## # A tibble: 4 × 4
## # Groups: lavadora [2]
## lavadora desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 1569 0.39
## 2 si no_desertor 2408 0.61
## 3 no desertor 598 0.49
## 4 no no_desertor 631 0.51tabla_univariada(entrena, auto, desertor)## # A tibble: 4 × 4
## # Groups: auto [2]
## auto desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 634 0.33
## 2 si no_desertor 1286 0.67
## 3 no desertor 1533 0.47
## 4 no no_desertor 1753 0.53tabla_univariada(entrena, microondas, desertor)## # A tibble: 4 × 4
## # Groups: microondas [2]
## microondas desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 1024 0.36
## 2 si no_desertor 1859 0.64
## 3 no desertor 1143 0.49
## 4 no no_desertor 1180 0.51tabla_univariada(entrena, computadora, desertor)## # A tibble: 4 × 4
## # Groups: computadora [2]
## computadora desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 662 0.29
## 2 si no_desertor 1631 0.71
## 3 no desertor 1505 0.52
## 4 no no_desertor 1408 0.48tabla_univariada(entrena, agua, desertor)## # A tibble: 4 × 4
## # Groups: agua [2]
## agua desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 1908 0.41
## 2 si no_desertor 2783 0.59
## 3 no desertor 259 0.5
## 4 no no_desertor 256 0.5tabla_univariada(entrena, telefono, desertor)## # A tibble: 4 × 4
## # Groups: telefono [2]
## telefono desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 932 0.33
## 2 si no_desertor 1888 0.67
## 3 no desertor 1235 0.52
## 4 no no_desertor 1151 0.48tabla_univariada(entrena, internet, desertor)## # A tibble: 4 × 4
## # Groups: internet [2]
## internet desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 507 0.28
## 2 si no_desertor 1306 0.72
## 3 no desertor 1660 0.49
## 4 no no_desertor 1733 0.51tabla_univariada(entrena, excusado, desertor)## # A tibble: 4 × 4
## # Groups: excusado [2]
## excusado desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 1900 0.41
## 2 si no_desertor 2772 0.59
## 3 no desertor 267 0.5
## 4 no no_desertor 267 0.5tabla_univariada(entrena, letrina, desertor)## # A tibble: 4 × 4
## # Groups: letrina [2]
## letrina desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 339 0.44
## 2 si no_desertor 425 0.56
## 3 no desertor 1828 0.41
## 4 no no_desertor 2614 0.59tabla_univariada(entrena, cable, desertor)## # A tibble: 4 × 4
## # Groups: cable [2]
## cable desertor n pcn
## <fct> <fct> <int> <dbl>
## 1 si desertor 715 0.34
## 2 si no_desertor 1398 0.66
## 3 no desertor 1452 0.47
## 4 no no_desertor 1641 0.53¿En qué tipo de prepa estudiaste la preparatoria?
tabla_univariada(entrena, tipo_escuela, desertor) %>%
ggplot(aes(tipo_escuela, pcn, fill = desertor)) +
geom_col(position = "stack") + ggtitle("¿En qué tipo de escuela estudiaste la prepa") +
xlab("") + theme(axis.text.x = element_text(angle = 90))
¿Con quien vives?
No parece ser una varaible relevante, ya que los porcentajes de desrción se ven muy similares en todos los casos
tabla_univariada(entrena, vive_con, desertor) %>%
ggplot(aes(vive_con, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿Con quien vives")
¿Si tiene problemas en el bachillerato confiaba en la escuela, la familia o los amigos?
Realmente la probabilidad de desertar aumenta si no confias en al escuela o la familia.
tabla_univariada(entrena, confia_esc, desertor) %>%
ggplot(aes(confia_esc, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿confias en la escuela?")
tabla_univariada(entrena, confia_familia, desertor) %>%
ggplot(aes(confia_familia, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿confias en la familia?")
tabla_univariada(entrena, confia_amigos, desertor) %>%
ggplot(aes(confia_amigos, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿confias en los amigos?")
¿Consumes alguan de las siguientes sustancias?
tabaco
alcohol
marihuana
otras_drogas
tabla_univariada(entrena, tabaco, desertor) %>%
ggplot(aes(tabaco, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿Consumes tabaco?")
tabla_univariada(entrena, alcohol, desertor) %>%
ggplot(aes(alcohol, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿Consumes alcohol?")
tabla_univariada(entrena, marihuana, desertor) %>%
ggplot(aes(marihuana, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿Consumes marihuana?")
tabla_univariada(entrena, otras_drogas, desertor) %>%
ggplot(aes(otras_drogas, pcn, fill = desertor)) +
geom_col(position = "dodge") + ggtitle("¿otras drogas?")
Preprocesamiento e ingenieria de entradas:
Usaremos una receta más simple (no necesariamente tenemos que poner interacciones, categorización de entradas, transformaciones no lineales):
receta <- recipe(desertor ~
sexo +
prom_sec +
cambio_esc +
asistencia +
reprueba +
prom_bach +
becado +
desertor_amigos +
desertor_hermanos +
faltaba_dinero +
prob_turno +
disg_estudiar +
mejor_trabaja +
no_entiende +
cambio_casa +
bulling +
disciplina_estricta +
discriminado +
prob_familia +
te_casaste +
estudiaran_hermanos +
embarazo +
estudiar_no_sirve +
baja_autoestima +
trab_est +
ncuartos +
dvd +
piso_tierra +
auto +
microondas +
computadora +
agua +
telefono +
internet +
excusado +
letrina +
cable +
tipo_escuela +
vive_con +
confia_esc +
confia_familia +
confia_amigos +
alcohol,
data = entrena) %>%
step_dummy(all_nominal_predictors()) %>%
step_zv(all_predictors()) #step_zv remove variables that contain only a single value.Dimensión de los datos:
prep(receta, entrena) %>% juice() %>% dim()## [1] 5206 61Empezamos con parámetros más o menos default
modelo_boosting <- boost_tree(learn_rate = 0.01, trees = 3000,
mtry = 5, tree_depth = 7, sample_size = 0.8) %>%
set_mode("classification") %>%
set_args(objective = "binary:logistic")
flujo <- workflow() %>% add_recipe(receta) %>% add_model(modelo_boosting)
flujo_fit <- fit(flujo, entrena)## [18:02:30] WARNING: amalgamation/../src/learner.cc:1115: Starting in XGBoost 1.3.0, the default evaluation metric used with the objective 'binary:logistic' was changed from 'error' to 'logloss'. Explicitly set eval_metric if you'd like to restore the old behavior.ajuste_xgboost <- flujo_fit %>% extract_fit_engine() %>% pluck("evaluation_log") %>%
as_tibble()
ggplot(ajuste_xgboost, aes(x=iter, y = training_logloss)) + geom_line()
valida <- testing(encuesta_part_val$splits[[1]])
preds_val <- predict(flujo_fit, valida, type = "prob") %>%
bind_cols(valida %>% select(desertor))mis_metricas <- metric_set(mn_log_loss, roc_auc)
mis_metricas(preds_val, truth = factor(desertor), .estimate = .pred_desertor, event_level = "first")## # A tibble: 2 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 mn_log_loss binary 0.422
## 2 roc_auc binary 0.885preds_entrena <- predict(flujo_fit, entrena, type = "prob") %>%
bind_cols(entrena %>% select(desertor))mis_metricas <- metric_set(mn_log_loss, roc_auc)
mis_metricas(preds_entrena, truth = factor(desertor), .estimate = .pred_desertor, event_level = "first")## # A tibble: 2 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 mn_log_loss binary 0.201
## 2 roc_auc binary 0.990ggplot(preds_val, aes(x = .pred_desertor, fill = factor(desertor))) + geom_histogram(alpha=0.8)
Preparar solución
La siguiente es la solución al problema que estamos planteando.
encuesta_test <- testing(encuesta_part_inicial)
preds_prueba_sol <- predict(flujo_fit, encuesta_test, type="prob") %>%
bind_cols(encuesta_test %>% select(desertor))
mis_metricas <- metric_set(mn_log_loss, roc_auc)
mis_metricas(preds_prueba_sol, truth = factor(desertor), .estimate = .pred_desertor, event_level = "first") ## # A tibble: 2 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 mn_log_loss binary 0.392
## 2 roc_auc binary 0.901Resultados:
- Esto modelo logra un score de \(0.3919\)
- Una curva ROC de \(.9010\)
roc_graf <- roc_curve(preds_prueba_sol, truth = factor(desertor), .pred_desertor,event_level = "first")
autoplot(roc_graf)
Interpretación del Modelo
Como se menciona en las notas del curso, Clase 15 Interpretación de modelos, buscamos responder ¿Cuánto contribuye cada variable al desempeño predictivo del modelo?. Para dar respuesta a esta pregunta se recurre a la idea de importancia basadas en permutaciones. En la cual se realiza el ajuste del modelo con un conjunto de entrenamiento y se toma un conjunto de datos de validación. En cada variable del modelo se realiza lo siguiente:
- Permutamos la variable en el conjunto de validación
- Hacemos predicciones con nuestro predictor
- Evaluamos el error de predicción
- Obtenemos la diferencia del error de predicción con las variables no permutadas A esta diferencia le llamamos importancia de la variable bajo el método de permutaciones.
pred_iml <- function(model, newdata){
predict(model, new_data = newdata) %>% pull(.pred_class)
}
predictor <- Predictor$new(model = flujo_fit, data = encuesta_test,
y = "desertor", predict.fun = pred_iml)vars_usadas <- extract_preprocessor(flujo_fit) %>% pluck("var_info") %>%
filter(role == "predictor") %>%
pull(variable)
imp_boosting <- FeatureImp$new(predictor, loss = "ce",
compare = "difference", n.repetitions = 5, features = vars_usadas)
importancias <- imp_boosting$results %>%
mutate(feature = fct_reorder(feature, importance))
ggplot(importancias, aes(x = feature, y = importance)) +
geom_hline(yintercept = 0, colour = "salmon") +
geom_point() + coord_flip()
Conclusión
Podemos observar que el modelo es bueno para predecir la deserción escolar, teniendo una pérdida logarítmicade \(0.3890\) y una curva ROC de \(.9035\), adicionalmente podemos observar la importancia de las varaibles, la cual es la siguiente.
- Promedio bachillerato
- Embarazo
- Le disgusta estudiar
- Se casó
- Mejor trabaja
- Tipo de escuela
- prom_secundaria
- número de cuartos en suc casa.
- asitencia al bachillerato
- faltaba dinero
Lineamientos para la elaboración de indicadores educativos↩︎